home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / systems / mac / euro-oztex / EOT2.1#2.sea.bin / PS-files / getfonts.ps < prev    next >
Text File  |  1989-06-04  |  1KB  |  76 lines
  1. %!
  2. % This modified fontlist.ps returns sorted list of resident fonts to host.
  3.  
  4. /MaxNrOfFonts 100 def   % Maximum numbers of fonts...
  5.  
  6. /num 0 def              % local counter
  7. /incr {
  8.   /num num 1 add def
  9. } def
  10.  
  11. /s40 { 40 string } def  % Proper length of the fontname
  12.  
  13. /newline {              % Send carriage return
  14.   (\r) print flush
  15. } def
  16.  
  17. /CountFonts {           % Count the fonts and put the names into array
  18.   FontDirectory
  19.   {
  20.     pop
  21.     s40
  22.     cvs
  23.     incr
  24.   }
  25.   forall
  26.   /FontArray num array def
  27.   FontArray astore
  28.   pop
  29. } def
  30.  
  31. /ListFonts {            % Sort the fonts and send them to host
  32.   Bubbelsort
  33.   FontArray
  34.   { print newline
  35.   }
  36.   forall
  37. } def
  38.  
  39. /Bubbelsort {           % Here is the sorting routine
  40.   1 1 num 1 sub
  41.   {
  42.     /localcount exch def
  43.     num 1 sub -1 localcount
  44.     {
  45.       /innercount exch def
  46.       /firststring FontArray innercount 1 sub get def
  47.       /secondstring FontArray innercount get def
  48.       firststring secondstring gt
  49.       {
  50.          FontArray innercount 1 sub secondstring put
  51.          FontArray innercount firststring put
  52.       } if
  53.     } for
  54.   } for
  55. } def
  56.  
  57. /Times-Roman findfont 12 scalefont setfont
  58.  
  59. CountFonts
  60. (Number of fonts: ) print
  61. num s40 cvs print newline
  62.  
  63. newline
  64. ListFonts
  65. newline
  66.  
  67. /Times-Bold findfont 12 scalefont setfont
  68. (Total memory: ) print
  69. vmstatus s40 cvs print newline
  70. (Memory used: ) print
  71. s40 cvs print newline
  72. pop
  73. (Free memory: ) print
  74. vmstatus exch sub s40 cvs print newline
  75. pop
  76.